home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / program / eflibpt4.zip / DEMO / DATATYPE / SORTPERF.PAS < prev    next >
Pascal/Delphi Source File  |  1996-08-18  |  3KB  |  99 lines
  1. { Borland Pascal Extended Function Library - EFLIB (C) Johan Larsson, 1996
  2.   Demonstration; sorting performance test
  3.  
  4.   EFLIB IS PROTECTED BY THE COPYRIGHT LAW AND MAY NOT BE COPIED, SOLD OR
  5.   MANIPULATED. FOR MORE INFORMATION, SEE PROGRAM MANUAL! THIS DEMONSTRAT-
  6.   ION PROGRAM MAY FREELY BE USED AND DISTRIBUTED.                          }
  7.  
  8.  
  9. uses EFLIBDEF, EFLIBINI, EFLIBBAS, EFLIBDAT, CRT;
  10.  
  11.  
  12. const NumberOfElements = 500;
  13.  
  14. var Data : array [1..6] of DataObjectPointerType;
  15.     Current : DataObjectPointerType; Timer : TimerObjectType;
  16.     Index, Number : word;
  17.  
  18. procedure Build;
  19. begin
  20.      { Build structure }
  21.      Current^.Clear;
  22.      for Index := 1 to NumberOfElements do begin
  23.          Number := Succ(Random(High(Number)));
  24.          Current^.Add (Number); { Add element }
  25.      end;
  26. end;
  27.  
  28. procedure Test;
  29. begin
  30.      RandSeed := 0; { Control random seed }
  31.  
  32.      Build;
  33.  
  34.      (* // Merge sort is under construction (not optimized) // *)
  35.  
  36.      { Sort structure with MergeSort while measuring the needed time }
  37.      Timer.Initialize;
  38.  (*  Current^.Sort (AscendingOrder, MergeSortAlgorithm); *)
  39.      Write (Timer.ElapsedMS:25:0);
  40.      Timer.Intercept;
  41.  
  42.      Build;
  43.  
  44.      { Sort structure with QuickSort while measuring the needed time }
  45.      Timer.Initialize;
  46.      Current^.Sort (AscendingOrder, QuickSortAlgorithm);
  47.      Write (Timer.ElapsedMS:20:0);
  48.      Timer.Intercept;
  49. end;
  50.  
  51. begin
  52.      WriteLn; TextBackground (Blue);
  53.      Write ('Datatype', '':32, 'Merge sort ........ Quick sort [ms] ');
  54.      TextBackground (Black); WriteLn;
  55.  
  56.      Write ('Array list          ');
  57.      Data[1] := New(ArrayListObjectPointerType, Initialize(NumberOfElements, SizeOf(Number)));
  58.      Current := Data[1]; Test; WriteLn;
  59.  
  60.      Write ('Virtual list        ');
  61.      Data[2] := New(VirtualListObjectPointerType, Initialize(0, Succ(NumberOfElements div 100), SizeOf(Number)));
  62.      Current := Data[2]; Test; WriteLn;
  63.  
  64.      Write ('Pointer list        ');
  65.      Data[3] := New(PointerListObjectPointerType, Initialize(NumberOfElements, 0, SizeOf(Number)));
  66.      Current := Data[3]; Test; WriteLn;
  67.  
  68.      Write ('Linked list         ');
  69.      Data[4] := New(LinkedListObjectPointerType, InitializeList(SizeOf(Number), UnsortedOrder, TRUE, TRUE));
  70.      Current := Data[4]; Test; WriteLn;
  71.  
  72. (*   Write ('Cached linked list  ');
  73.      Data[5] := New(CachedLinkedListObjectPointerType, InitializeList(SizeOf(Real), NumberOfElements div 50,
  74.                  UnsortedOrder, FALSE, FALSE));
  75.      Current := Data[5]; Test; WriteLn; *)
  76.  
  77. (*   Write ('Segment linked list ');
  78.      Data[6] := New(SegmentLinkedListObjectPointerType, InitializeList(SizeOf(Real), NumberOfElements div 50,
  79.                  UnsortedOrder, FALSE, FALSE));
  80.      Current := Data[6]; Test; WriteLn; *)
  81.  
  82.      WriteLn ('Verifying sort order ...');
  83.  
  84.      for Index := 1 to SizeOf(Data) div SizeOf(DataObjectPointerType) do
  85.          if Data[Index]^.IsInitialized then
  86.             if not Data[Index]^.IsSorted (AscendingOrder) then
  87.                WriteLn ('Data type ', Index, ' was not correctly sorted.');
  88.  
  89.      WriteLn ('Done.');
  90.  
  91.      { Dispose all data structures }
  92.      for Index := 1 to SizeOf(Data) div SizeOf(DataObjectPointerType) do
  93.          if Data[Index]^.IsInitialized then Data[Index]^.Free;
  94.  
  95.      if GlobalDataError then WriteLn ('Error(s) reported!');
  96. end.
  97.  
  98.  
  99.